unit JsonUtils;

interface

uses DBXJSON, Rtti, NullableTypes, TypInfo, RttiUtils;

function JSONToObject(AJSONObject: TJSONObject): TObject;
function ObjectToJSON(AObject: TObject): TJSONObject;

implementation

function JSONToObject(AJSONObject: TJSONObject): TObject;
var
  RttiContext: TRttiContext;
  RttiType: TRttiType;
  RttiField: TRttiField;
  RttiMethod: TRTTIMethod;
  Value: TValue;

  TypeName: string;
  TypeField: string;
  FieldName: string;
  Pair: TJSONPair;
  FieldsObj: TJSONObject;
  FieldObj: TJSONObject;
  FieldsProp: TJSONObject;
  I: Integer;

  NI: Nullable<Integer>;
  NN: Nullable<Double>;
  NS: Nullable<string>;
  NB: Nullable<Boolean>;
  ND: Nullable<TDate>;

  vChar: Char;
begin
  Result := nil;

  if AJSONObject.Size <> 3 then
    Exit;

  Assert(AJSONObject.Get(0).JsonString.Value = 'type');
  Assert(AJSONObject.Get(1).JsonString.Value = 'id');
  Assert(AJSONObject.Get(2).JsonString.Value = 'fields');

  TypeName := TJSONString(AJSONObject.Get(0).JsonValue).Value;

  Result := ObjectInstance(TypeName);

  if not Assigned(Result) then
    Exit;

  FieldsObj := AJSONObject.Get(2).JsonValue as TJSONObject;

  RttiType := RttiContext.GetType(Result.ClassType);

  for I := 0 to FieldsObj.Size - 1 do
  begin
    Value := TValue.Empty;

    //Field
    Pair := FieldsObj.Get(I);
    FieldName := Pair.JsonString.Value;

    case FieldTypeKind(Result,FieldName) of
      tkInteger,
      tkInt64:
        begin
          Value := TJSONNumber(Pair.JsonValue).AsInt;
        end;
      tkEnumeration:
        begin
          //Boolean True
          if Pair.JsonValue is TJSONTrue then
          begin
            Value := True;
          end
          else
          //Boolean False
          if Pair.JsonValue is TJSONFalse then
          begin
            Value := False;
          end
        end;
      tkFloat:
        begin
          Value := TJSONNumber(Pair.JsonValue).AsDouble;
        end;
      tkString,
      tkLString,
      tkWString,
      tkUString:
        begin
          Value := TJSONString(Pair.JsonValue).Value;
        end;
      tkChar,
      tkWChar:
        begin
          if Pair.JsonValue.Value = '' then
            vChar := #0
          else
            vChar := Pair.JsonValue.Value[1];

          RttiField := RttiType.GetField(FieldName);
          TValue.Make(@vChar, RttiField.FieldType.Handle, Value);
        end;
      tkRecord:
        begin
          RttiField := RttiType.GetField(FieldName).FieldType.GetField('FValue');
          if Assigned(RttiField) then
          begin
            FieldObj := Pair.JsonValue as TJSONObject;
            //Type Field
            Pair := FieldObj.Get(0);
            TypeField := TJSONString(Pair.JsonValue).Value;
            //Field Properties
            Pair := FieldObj.Get(2);
            FieldsProp := Pair.JsonValue as TJSONObject;
            //HasValue
            Pair := FieldsProp.Get(0);
            if Pair.JsonValue is TJSONTrue then
            begin
              //Value
              Pair := FieldsProp.Get(1);

              case RttiField.FieldType.TypeKind of
                tkInteger,
                tkInt64:
                  begin
                    NI := TJSONNumber(Pair.JsonValue).AsInt;
                    Value := TValue.From(NI);
                  end;
                tkFloat:
                  begin
                    if Pos('TDate',TypeField) > 0 then
                    begin
                      ND := TJSONNumber(Pair.JsonValue).AsDouble;
                      Value := TValue.From(ND);
                    end
                    else
                    begin
                      NN := TJSONNumber(Pair.JsonValue).AsDouble;
                      Value := TValue.From(NN);
                    end;
                  end;
                tkString,
                tkUString,
                tkWString:
                  begin
                    NS := TJSONString(Pair.JsonValue).Value;
                    Value := TValue.From(NS);
                  end;
                tkEnumeration:
                  begin
                    NB := Pair.JsonValue is TJSONTrue;
                    Value := TValue.From(NB);
                  end;
              end;
            end;
          end;
        end;
    end;

    if not Value.IsEmpty then
    begin
      RttiField := RttiType.GetField(FieldName);
      if Assigned(RttiField) then
      begin
        RttiField.SetValue(Result,Value);
      end;
    end;
  end;
end;

function ObjectToJSON(AObject: TObject): TJSONObject;
var
  RttiContext: TRttiContext;
  RttiType: TRttiType;
  RttiField: TRttiField;
  FieldsObj, ClassObj: TJSONObject;
  Pair: TJSONPair;
  ObjValue: TJSONObject;
  ObjFieldsValue: TJSONObject;
  Value: TValue;

  NI: Nullable<Integer>;
  NN: Nullable<Double>;
  NS: Nullable<string>;
  NB: Nullable<Boolean>;

  vChar: Char;
begin
  FieldsObj := TJSONObject.Create;

  RttiType := RttiContext.GetType(AObject.ClassType);

  for RttiField in RttiType.GetFields do
  begin
    Pair := nil;

    case RttiField.FieldType.TypeKind of
      tkInteger:
        begin
          Value := RttiField.GetValue(AObject);
          Pair := TJSONPair.Create(RttiField.Name,TJSONNumber.Create(Value.AsInteger));
        end;
      tkInt64:
        begin
          Value := RttiField.GetValue(AObject);
          Pair := TJSONPair.Create(RttiField.Name,TJSONNumber.Create(Value.AsInt64));
        end;
      tkFloat:
        begin
          Value := RttiField.GetValue(AObject);
          Pair := TJSONPair.Create(RttiField.Name,TJSONNumber.Create(Value.AsExtended));
        end;
      tkString,
      tkLString,
      tkWString,
      tkUString:
        begin
          Value := RttiField.GetValue(AObject);
          Pair := TJSONPair.Create(RttiField.Name,TJSONString.Create(Value.AsString));
        end;
      tkChar,
      tkWChar:
        begin
          Value := RttiField.GetValue(AObject);

          vChar := Value.AsType<Char>;
          if vChar = #0 then
            Pair := TJSONPair.Create(RttiField.Name,TJSONString.Create(''))
          else
            Pair := TJSONPair.Create(RttiField.Name,TJSONString.Create(vChar));
        end;
      tkEnumeration:
        begin
          Value := RttiField.GetValue(AObject);
          if Value.AsBoolean then
            Pair := TJSONPair.Create(RttiField.Name,TJSONTrue.Create)
          else
            Pair := TJSONPair.Create(RttiField.Name,TJSONFalse.Create);
        end;
      tkClass:
        begin

        end;
      tkRecord:
        begin
          Value := RttiField.GetValue(AObject);

          if Copy(Value.TypeInfo.Name,1,9) = 'Nullable<' then
          begin
            case RttiField.FieldType.GetField('FValue').FieldType.TypeKind of
              tkInteger,
              tkInt64:
                begin
                  Value.ExtractRawData(@NI);

                  ObjValue := TJSONObject.Create;

                  ObjValue.AddPair('type',TJSONString.Create(NullableTypes.UNIT_NAME+'.'+String(Value.TypeInfo.Name)));

                  ObjFieldsValue := TJSONObject.Create;
                  if NI.HasValue then
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONTrue.Create);
                    ObjFieldsValue.AddPair('Value',TJSONNumber.Create(NI));
                  end
                  else
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONFalse.Create);
                    ObjFieldsValue.AddPair('Value',TJSONNumber.Create(0));
                  end;


                  ObjValue.AddPair('id',TJSONNumber.Create(1));
                  ObjValue.AddPair('fields',ObjFieldsValue);

                  Pair := TJSONPair.Create(RttiField.Name,ObjValue);
                end;
              tkEnumeration:
                begin
                  Value.ExtractRawData(@NB);

                  ObjValue := TJSONObject.Create;

                  ObjValue.AddPair('type',TJSONString.Create(NullableTypes.UNIT_NAME+'.'+String(Value.TypeInfo.Name)));

                  ObjFieldsValue := TJSONObject.Create;
                  if NB.HasValue then
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONTrue.Create);

                    if NB then
                      ObjFieldsValue.AddPair('Value',TJSONTrue.Create)
                    else
                      ObjFieldsValue.AddPair('Value',TJSONFalse.Create);
                  end
                  else
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONFalse.Create);
                    ObjFieldsValue.AddPair('Value',TJSONFalse.Create);
                  end;


                  ObjValue.AddPair('id',TJSONNumber.Create(1));
                  ObjValue.AddPair('fields',ObjFieldsValue);

                  Pair := TJSONPair.Create(RttiField.Name,ObjValue);
                end;
              tkFloat:
                begin
                  Value.ExtractRawData(@NN);

                  ObjValue := TJSONObject.Create;

                  ObjValue.AddPair('type',TJSONString.Create(NullableTypes.UNIT_NAME+'.'+String(Value.TypeInfo.Name)));

                  ObjFieldsValue := TJSONObject.Create;
                  if NN.HasValue then
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONTrue.Create);
                    ObjFieldsValue.AddPair('Value',TJSONNumber.Create(NN));
                  end
                  else
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONFalse.Create);
                    ObjFieldsValue.AddPair('Value',TJSONNumber.Create(0));
                  end;


                  ObjValue.AddPair('id',TJSONNumber.Create(1));
                  ObjValue.AddPair('fields',ObjFieldsValue);

                  Pair := TJSONPair.Create(RttiField.Name,ObjValue);
                end;
              tkString,
              tkWChar,
              tkLString,
              tkWString,
              tkUString:
                begin
                  Value.ExtractRawData(@NS);

                  ObjValue := TJSONObject.Create;

                  ObjValue.AddPair('type',TJSONString.Create(NullableTypes.UNIT_NAME+'.'+String(Value.TypeInfo.Name)));

                  ObjFieldsValue := TJSONObject.Create;
                  if NS.HasValue then
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONTrue.Create);
                    ObjFieldsValue.AddPair('Value',TJSONString.Create(NS));
                  end
                  else
                  begin
                    ObjFieldsValue.AddPair('HasValue',TJSONFalse.Create);
                    ObjFieldsValue.AddPair('Value',TJSONString.Create(''));
                  end;


                  ObjValue.AddPair('id',TJSONNumber.Create(1));
                  ObjValue.AddPair('fields',ObjFieldsValue);

                  Pair := TJSONPair.Create(RttiField.Name,ObjValue);
                end;
            end;
          end;
        end;
    end;

    if Assigned(Pair) then
      FieldsObj.AddPair(Pair);
  end;

  ClassObj := TJSONObject.Create;

  Pair := TJSONPair.Create('type',TJSONString.Create(RttiType.QualifiedName));
  ClassObj.AddPair(Pair);

  Pair := TJSONPair.Create('id',TJSONNumber.Create(1));
  ClassObj.AddPair(Pair);

  Pair := TJSONPair.Create('fields',FieldsObj);
  ClassObj.AddPair(Pair);

  Result := ClassObj;
end;

end.
